home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
prot018s.zip
/
TERM.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1993-01-07
|
13KB
|
511 lines
{ MiniTerminal program - to show the useage of the Protocol Engine. }
{ (C) 1992 Mark Dignam - OmenTronics - Perth Omen BBS - 3:690/660@fidonet }
{
This is a very simple terminal program that I threw together to show you
just how easy the ProtEng unit is to use.
It may or may not work on your system. It is only written to take up space
on your hard disk.
Known Bugs.
Don't select a Com port that doesn't exist while using a Fossil driver.
For some reason this locks the system up!
}
{$M 16384,0,150000}
Uses
Dos,crt,ProtComm,Proteng,Ansi_Drv;
Type
scr = array[1..2000] of
record
character : char;
attribute : byte;
end;
scrprt = ^scr;
Const
BoxCol = White + (Blue * 16);
TextCol = LightCyan;
Baudrates : Array[1..9] of longint = (150,300,600,1200,2400,4800,9600,19200,38400);
Version = 'v0.01';
var
Finish,Doorway : Boolean;
DownDir : String[64];
scrbuff,
savescreen : scrprt;
OldX,Oldy,BoxW,
OldText,Lines,
CurBaud,Curport : Byte;
Regs : Registers;
procedure OnCursor;
begin
Regs.ax := 1 shl 8;
Regs.cx := 6 shl 8 + 7;
intr($10,Regs);
end;
procedure OffCursor;
begin
Regs.ax := 1 shl 8;
Regs.cx := 14 shl 8;
intr($10,Regs);
end;
Function GetPath( Thepath : String) : String;
var
n : NameStr;
e : ExtStr;
d : DirStr;
begin
Fsplit(Thepath,d,n,e);
Getpath := d;
end;
procedure position(x,y,col : byte; ch : char);
var
i : word;
begin
i := ((((y - 1) * 80) + (x - 1)) + 1);
scrbuff^[i].attribute := col;
scrbuff^[i].character := ch;
end;
Procedure Save_Screen;
begin
Oldx := Wherex;
OldY := wherey;
OldText := TextAttr;
if (mem[0000:$0449] = $7) then
scrbuff := ptr($b000,0000)
else
scrbuff := ptr($b800,0000);
if memavail >= sizeof(scr) then
begin
New(SaveScreen);
savescreen^ := scrbuff^;
end
else
begin
writeln('Can''t allocate memory for screen image');
halt(1);
end;
OnCursor;
end;
procedure make_window(x1,y1,x2,y2,col,btype : byte);
Const
tl : string[5] = '┌╓╒╔+'; tr : string[5] = '┐╖╕╗+';
bl : string[5] = '└╙╘╚+'; br : string[5] = '┘╜╛╝+';
hs : string[5] = '──══-'; vs : string[5] = '│║│║|';
var
i : word;
temp : String[80];
begin
Save_Screen;
OffCursor;
position(x1,y1,col,tl[btype]);
position(x2,y1,col,tr[btype]);
position(x1,y2,col,bl[btype]);
position(x2,y2,col,br[btype]);
for i := (x1 + 1) to (x2 - 1) do
begin
position(i,y1,col,hs[btype]);
position(i,y2,col,hs[btype]);
end;
for i := (y1 + 1) to (y2 - 1) do
begin
position(x1,i,col,vs[btype]);
position(x2,i,col,vs[btype]);
end;
fillchar(temp[1],x2-x1-1,32);
temp[0] := chr(x2-x1-1);
textAttr := BoxCol;
for i := (y1 + 1) to (y2 - 1) do
begin
gotoxy(x1+1,i);
Write(temp);
end;
window(x1 + 1,y1 + 1,x2 - 1,y2 - 1);
end;
procedure Remove_Window;
begin
scrbuff^ := savescreen^;
dispose(Savescreen);
Window(1,1,80,25);
TextAttr := OldText;
Gotoxy(OldX,OldY);
OnCursor;
end;
Procedure popup(Message : String);
Var
i,j : Byte;
Begin
i := Length(message);
j := 40 - (i shr 1);
make_window(j-2,10,j+i+1,12,White + (blue * 16),1);
GotoXy(2,1);
Write(message);
Delay(500);
Remove_Window;
end;
Procedure PopupLines(Message : String; MaxLines,MaxWidth : Byte);
Var
i,j : Byte;
Begin
If (MaxLines > 0) and (maxlines < 25) then
Begin
Boxw := MaxWidth;
i := Boxw Div 2;
j := 40 - i;
make_window(j-2,8,j+Boxw+1,10+MaxLines,white + (Blue* 16),1);
Lines := 1;
end;
i := (Boxw - length(Message)) Div 2;
Gotoxy(2 + i,Lines);
Inc(Lines);
Write(message);
end;
Procedure Currentsettings;
var
temp1,temp2 : String;
Begin
Str(Baudrates[curbaud],temp1);
Str(CurPort,temp2);
Popup('Current Baud rate is '+temp1+' using comm port '+temp2);
end;
Procedure ShowHelp;
var
ch : char;
temp1,temp2 : String;
Begin
Str(Baudrates[curbaud],temp1);
Str(CurPort,temp2);
PopupLines('The Help Screen for Term',12,40);
PopupLines('──────────────────────────────────────',0,0);
PopupLines('Alt_X - Exit',0,0);
PopupLines('Alt_J - Dos Shell',0,0);
PopupLines('Alt_B - change baud rate',0,0);
PopupLines('Alt_P - change Comm port',0,0);
PopupLines('Alt_H - Drop Dtr and hang up',0,0);
PopupLines('PageUp - UpLoad file to remote',0,0);
Popuplines('PageDown - Download file from remote',0,0);
PopupLines('──────────────────────────────────────',0,0);
PopupLines('Speed is '+temp1+' baud - Port is '+Temp2,0,0);
PopupLines('──────────────────────────────────────',0,0);
PopupLines('Hit Any Key',0,0);
ch := readkey;
remove_Window;
end;
Procedure HangUp;
begin
Comm_Dtr_off;
Delay(1000);
Comm_Dtr_On;
end;
Procedure SetPort;
var
GoodPort : Boolean;
begin
Inc(Curport);
If Curport = 5 then curport := 1;
repeat
Comm_Deinit;
Goodport := comm_init(BaudRates[CurBaud],CurPort);
If Not Goodport Then Inc(CurPort);
If Curport = 5 then curport := 1;
Until Goodport;
CurrentSettings;
end;
Procedure SetBaudRate;
begin
Inc(Curbaud);
if Curbaud > 9 then Curbaud := 1;
Comm_SetDirect(BaudRates[CurBaud]);
Currentsettings;
end;
Procedure UpLoadfiles;
var
Ch : Char;
Fname,temp1,temp2 : String;
temp3 : Str64;
GoodFile : Boolean;
Sr : SearchRec;
i,j : Byte;
GotMem : Boolean;
begin
PopupLines('Uploading - ',5,20);
Popuplines('<X> - XModem ',0,0);
Popuplines('<1> - 1KXmodem',0,0);
Popuplines('<Y> - YModem ',0,0);
Popuplines('<Z> - ZModem ',0,0);
Popuplines('<P> - Yapp ',0,0);
Ch := readKey;
ch := upcase(ch);
Remove_Window;
If (ch in ['X','1','Y','Z','P','G','S']) then
begin
ClearNameList;
Popuplines('',2,74);
PopUpLines('Filename(s) to send ->____________________________________________________',0,0);
Gotoxy(24,2);
OnCursor;
Readln(fname);
Remove_Window;
If Length(Fname) = 0 then
Ch := chr(0)
Else
Begin
j := 0;
For i := 1 to length(Fname) do
if fname[i] in [' ',';'] then fname[i] := ',';
GotMem := True;
repeat
i := pos(',',fname);
if I = 0 then i := Length(fname) + 1;
temp1 := copy(fname,1,i-1);
Delete(fname,1,i);
Temp2 := Getpath(temp1);
FindFirst(temp1,$27,sr);
While (Doserror = 0) and GotMem do
begin
inc(j);
Temp3 := Temp2 + Sr.name;
GotMem := AddNametoList(Temp3);
FindNext(sr);
end;
Until (Length(Fname) = 0) or (not GotMem);
NumberofFiles := j;
end;
Case ch of
'S' : GoodFile := SealinkTx;
'X' : Goodfile := XmodemTx;
'1' : Goodfile := Xmodem1KTx;
'Y' : Goodfile := YmodemtX;
'G' : Goodfile := YmodemGtx;
'Z' : Goodfile := ZmodemtX;
{ 'P' : Goodfile := YapptX;}
end;
end;
end;
procedure Downloadfiles;
var
Ch : Char;
Fname : String;
MoreFiles,
GoodFile : Boolean;
begin
PopupLines('Downloading - ',5,20);
Popuplines('<X> - XModem ',0,0);
Popuplines('<1> - 1KXmodem',0,0);
Popuplines('<Y> - YModem ',0,0);
Popuplines('<Z> - ZModem ',0,0);
Popuplines('<P> - Yapp ',0,0);
Ch := readKey;
ch := upcase(ch);
Remove_Window;
If (ch in ['X','1','Y','Z','P','S','G']) then
begin
If Ch in ['X','1'] then
begin
Popuplines('',2,50);
PopUpLines('Filename to receive ->___________________________',0,0);
Gotoxy(24,2);
OnCursor;
Readln(fname);
Remove_Window;
If Length(Fname) = 0 then Ch := chr(0);
Uploadpath := DownDir + Fname;
end
else
UploadPath := DownDir;
Case ch of
'X','1' : Goodfile := XmodemRx;
'Y' : Goodfile := YmodemRX;
'G' : Goodfile := YmodemGRX;
'S' : Goodfile := SealinkRX;
'Z' : Goodfile := ZmodemRX;
'P' : Goodfile := YappRX;
end;
end;
end;
Procedure GetParms;
var
l : longint;
I : Byte;
j : Integer;
temp : String;
ch : Char;
begin
if Paramcount > 0 then
begin
for i := 1 to paramcount do
begin
temp := Paramstr(i);
if temp[1] = '-' then Delete(temp,1,1);
Ch := upcase(Temp[1]);
Delete(temp,1,1);
Case ch of
'B' : Begin
Val(temp,l,j);
If (j = 0) then
repeat
inc(j);
until l <= BaudRates[j];
CurBaud := j;
end;
'D' : begin
DownDir := temp;
If DownDir[Length(downdir)] <> '\' then
DownDir := Downdir + '\';
end;
'P' : Begin
Val(temp,l,j);
If j = 0 then CurPort := Byte(l);
end;
end;
end;
end;
end;
Procedure DosShell;
begin
Save_Screen;
writeln('Going to dos');
Exec(GetEnv('COMSPEC'),'');
Remove_Window;
end;
Procedure TermMode;
Var
Lastchars : String[6];
Ch : Char;
GoodFile : Boolean;
begin
Lastchars := '';
repeat
If Comm_Rx_Ready then
begin
ch := chr(comm_rx);
if Length(lastchars) = 6 then delete(lastchars,1,1);
lastchars := lastchars + ch;
Ansi_write(ch);
if Lastchars = '**'+ chr($18) + 'B00' then
begin
ClearnameList;
Uploadpath := Downdir;
Goodfile := zmodemrx;
end;
end;
If Keypressed then
begin
Ch := Readkey;
if ch = #0 then
if Doorway then
begin
Ch := Readkey;
If CH <> #131 then { alt-= }
begin
Comm_TX(0);
Comm_Tx(Ord(ch));
end
else
begin
Doorway := false;
Popup('Doorway mode OFF');
end;
end
else
begin
Ch := Readkey;
case ch of
#25 : SetPort; {Alt_P }
#35 : Hangup; {Alt_H }
#36 : DosShell; {Alt_J }
#45 : Finish := true; {Alt_X }
#48 : SetbaudRate; {Alt_B }
#59 : ShowHelp; {F1 }
#73 : UploadFiles; {PageUp}
#81 : DownloadFiles; {PageDn}
#131 : begin {Alt_= }
Doorway := True;
Popup('Doorway mode ON');
end;
end;
end
else
Comm_Tx(ord(ch));
end;
until finish;
end;
begin
writeln('Term ',version,' - Demo program for the Protocol Engine.');
Writeln('Hit F1 for help - (c) 1992 Mark Dignam - OmenTronics');
TextAttr := LightGray;
CanUseFossil := True;
Comm_Cts_Rts(True);
overwrite := false;
finish := false;
Doorway := False;
CurBaud := 5;
CurPort := 1;
Downdir := 'c:\temp\';
WindowType := 1;
GetParms;
IF comm_init(BaudRates[CurBaud],CurPort) then
begin
CurrentSettings;
TermMode;
Comm_deinit;
end
else
begin
Writeln('Sorry - but I can''t initalise port ',curport);
end;
End.